home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib20b.dsk / RPN CALCULATOR (II PLUS).bas < prev   
BASIC Source File  |  2023-02-26  |  4KB  |  78 lines
  1. 1  REM  **********************
  2. 2  REM  *        RPN         *
  3. 3  REM  * BY  SKENE H. MOODY *
  4. 4  REM  * COPYRIGHT (C) 1984 *
  5. 5  REM  * BY MICROSPARC, INC *
  6. 6  REM  * LINCOLN, MA. 01773 *
  7. 7  REM  **********************
  8. 50  ONERR  GOTO 3000
  9. 60  GOSUB 2000
  10. 100  GET A$
  11. 110  IF A$ = ";"  THEN A$ = "+"
  12. 120  IF A<CTRL-A>$ = ":"  THEN A$ = "*"
  13. 130  IF A$ = "N"  THEN A$ = "^"
  14. 135  IF B$ = "-"  AND  ASC(A$) = 13  THEN X =  -X: GOTO 700
  15. 140  IF A$ = "C"  THEN B$ = "-" +B$: HTAB 1: PRINT B$;: GOTO 100
  16. 150  IF A$ = "F"  THEN  GOSUB 1500: GOTO 100
  17. 160  PRINT A$;:B$ = B$ +A$: IF  ASC(B$) = 13  THEN T = Z:Z = Y:Y = X: PRINT X:B$ = "": GOTO 100
  18. 170 TE =  ASC(A$): IF (TE >47  AND TE <58)  OR (TE = 69)  OR (A$ = ".")  THEN 100
  19. 180  IF TE = 13  THEN T = Z:Z = Y:Y = X:X =  VAL(B$):B$ = "": GOTO 100
  20. 190  IF TE = 8  AND  LEN(B$) <3  THEN B$ = "": PRINT " "; CHR$(8);: GOTO 100
  21. 200  IF TE = 8  THEN B$ =  LEFT$(B$, LEN(B$) -2): PRINT " "; CHR$(8);: GOTO 100
  22. 220  IF  LEN(B$) >1  THEN  IF TE = 45  AND  MID$ (B$, LEN(B$) -1,1) = "E"  THEN 100
  23. 300  IF  LEN(B$) >1  THEN T = Z:Z = Y:Y = X:X =  VAL(B$)
  24. 310  IF A$ = "+"  THEN X = X +Y: GOTO 500
  25. 320  IF A$ = "-"  THEN X = Y -X: GOTO 500
  26. 330  IF A$ = "*"  THEN X = X *Y: GOTO 500
  27. 340  IF A$ = "/"  THEN X = Y/X: GOTO 500
  28. 350  IF A$ = "^"  THEN X = Y ^X: GOTO 500
  29. 360  IF A$ = "L"  THEN X =  LOG(X): GOTO 700
  30. 370  IF A$ = "Q"  THEN X =  SQR(X): GOTO 700
  31. 380  IF A$ = "X"  THEN X =  EXP(X): GOTO 700
  32. 400  IF A$ = "S"  THEN TE = X:X = Y:Y = TE: GOSUB 610: GOTO 100
  33. 410  IF A$ = "R"  THEN  GOSUB 610: GOTO 100
  34. 420  IF A$ = "D"  THEN TE = X:X = Y:Y = Z:Z = T:T = TE: GOSUB 610: GOTO 100
  35. 430  IF A$ = "U"  THEN TE = T:T = Z:Z = Y:Y = X:X = TE: GOSUB 610: GOTO 100
  36. 490  GOTO 100
  37. 500 Y = Z:Z = T:B$ = "": IF   NOT (F)  OR  ABS(X) =  >1E9  THEN  PRINT : PRINT X: GOTO 100
  38. 600 XX = X: GOSUB 1000: GOTO 100
  39. 610  PRINT : PRINT "T = ";T: PRINT "Z = ";Z: PRINT "Y = ";Y: PRINT "X = ";X:B$ = "": RETURN 
  40. 700 B$ = "": IF   NOT (F)  OR  ABS(X) > = 1E9  THEN  PRINT : PRINT X: GOTO 100
  41. 710 XX = X: GOSUB 1000: GOTO 100
  42. 1000  PRINT :S =  SGN(XX):IL = W% -D% -1: IF D% = 0  THEN IL = IL +1
  43. 1020 N2 = 10 ^D%:N1 =  ABS(XX) +.5/N2:IP =  INT(N1):FP =  INT(N2 *(N1 -IP)) +N2:X$ =  STR$(IP):L =  LEN(X$):C = (L -1)/3:B% = 3
  44. 1080  IF C <1  THEN 1100
  45. 1090 X$ =  LEFT$(X$, LEN(X$) -B%) +"," + RIGHT$(X$,B%):B% = B% +4:C = C -1:IL = IL -1: GOTO 1080
  46. 1100  IF IL = 0  AND IP = 0  THEN X$ = "":L = 0
  47. 1110  IF S <0  THEN L = L +1:X$ = "-" +X$: IF IP = 0  AND IL = 1  THEN X$ = "-":L = 1
  48. 1120  IF IL <L  THEN 1160
  49. 1130  IF IL >L  THEN X$ = " " +X$:L = L +1: GOTO 1130
  50. 1140  IF D% >0  THEN X$ = X$ +"." + RIGHT$( STR$(FP),D%)
  51. 1150  PRINT X$: RETURN 
  52. 1160 X$ = "*************************":X$ =  LEFT$(X$,W%): PRINT X$: RETURN 
  53. 1500  INPUT "HOW MANY DECIMALS ? ";D%: IF D% >9  THEN F = 0: RETURN 
  54. 1510 F = 1:W% = 19: RETURN 
  55. 2000  TEXT : HOME : PRINT " KEY    FUNCTION"
  56. 2010  PRINT "------  ---------"
  57. 2020  PRINT "RETURN  ENTER (^)"
  58. 2030  PRINT "  C     CHANGE SGN"
  59. 2040  PRINT "+ OR ;  ADD"
  60. 2050  PRINT "  -     SUBTRACT"
  61. 2060  PRINT "* OR :  MULTIPLY"
  62. 2070  PRINT "  /     DIVIDE"
  63. 2080  PRINT "^ OR N  Y ^ X"
  64. 2090  PRINT "  L     LN (X)"
  65. 2100  PRINT "  X     EXP (X)"
  66. 2110  PRINT "  Q     SQRT (X)"
  67. 2120  PRINT "------------------"
  68. 2130  PRINT " <--    RUBOUT"
  69. 2140  PRINT "(R)EV.  REVIEW STK"
  70. 2150  PRINT "(S)WAP  X <--> Y"
  71. 2160  PRINT "(D)OWN  ROLL DOWN"
  72. 2170  PRINT "(U)P    ROLL UP"
  73. 2180  PRINT "  F     SET FORMAT": PRINT "------------------": PRINT : PRINT "COPYRIGHT 1984 BY": PRINT "MICROSPARC,  INC."
  74. 2190  FOR I = 1 TO 24: VTAB I: HTAB 19: PRINT "!";: NEXT : POKE 32,20: POKE 33,20:D% = 2: GOSUB 1510: HOME : RETURN 
  75. 3000 I =  PEEK(222): PRINT  CHR$(7): PRINT "ERR:";: IF I = 0  OR I >15  THEN J = 53856 +I +(I = 255) * -1: GOTO 3020
  76. 3010 J = 43377 + PEEK(43583 +I)
  77. 3020 K =  PEEK(J): PRINT  CHR$(K);: IF K <192  THEN J = J +1: GOTO 3020
  78. 3030  PRINT :A$ = "R": GOTO 410